perm filename TRANSF.F4[IRC,LCS]1 blob sn#641771 filedate 1982-02-15 generic text, type T, neo UTF8
00100	C  READS IN TWO FILES FOR TRANSFORMATION
00200		IMPLICIT INTEGER (X-Z)
00300		DIMENSION RN(3)
00400	C  RN WILL HOLD FILE NAMES
00500		COMMON /A/X1(800),Y1(800),Z1(800),K1
00600		COMMON /B/X2(800),Y2(800),Z2(800),K2
00700		COMMON /C/X3(800),Y3(800),Z3(800),K3
00800		COMMON /D/X4(800),Y4(800),Z4(800),K4
00900		CALL READX(1)
01000		CALL READX(2)
01100	C	IF(K1.LT.K2)GO TO 1
01200	C	CALL REVERS
01300	C1	CALL EQUALO
01400	C ASSUMES OUTLINE IS FIRST LONG CONTINUOUS LINE.
01500	C FIRST EQUALIZES OUTLINE, THEN THE REST
01600	C	CALL EQUALZ
01700		CALL EQUAL
01800	2	CALL PRCNTQ
01900		CALL OUTPUT
02100	100	END
02200	
02300		SUBROUTINE EQUAL
02400		COMMON /A/X1(800),Y1(800),Z1(800),K1
02500		COMMON /D/X4(800),Y4(800),Z4(800),K4
02600		COMMON /B/X2(800),Y2(800),Z2(800),K2
02700		COMMON /C/X3(800),Y3(800),Z3(800),K3
02800		L=1
02900		K=1
03000		M=0
03100	4	I=K
03200		J=L
03300		CALL SEG(Z1,K,K1,NN1)
03400		CALL SEG(Z2,L,K2,NN2)
03500		A=NN1
03600		B=NN2
03700		IF(NN1.GT.NN2)GO TO 1
03800		C=A/B
03900		D=I
04000	2	DO 3 KK=J,L
04100		M=M+1
04200		N=D
04300		X4(M)=X2(KK)
04400		Y4(M)=Y2(KK)
04500	C	Z4(M)=Z2(KK)
04600		X3(M)=X1(N)
04700		Y3(M)=Y1(N)
04800		Z3(M)=Z2(KK)
04900	3	D=D+C
05000	6	K=K+1
05100		L=L+1
05200		IF(K.LT.K1)GO TO 4
05300		K3=M
05400		RETURN
05500	1	C=B/A
05600		D=J
05700		DO 5 KK=I,K
05800		M=M+1
05900		N=D
06000		X3(M)=X1(KK)
06100		Y3(M)=Y1(KK)
06200		Z3(M)=Z1(KK)
06300		X4(M)=X2(N)
06400		Y4(M)=Y2(N)
06500	C	Z4(M)=Z2(KK)
06600	5	D=D+C
06700		GO TO 6
06800		END
06900	
07000		SUBROUTINE SEG(Z,K,K1,NN)
07100		DIMENSION Z(1)
07200		DO 1 N=K+1,K1
07300	1	IF(Z(N).NE.0)GO TO 2
07400		N=K1+1
07500	2	NN=N-K
07550		K=N-1
07600		END
07700	
07800		SUBROUTINE PRCNTQ
07900		IMPLICIT INTEGER (X-Z)
08000		COMMON /A/X1(800),Y1(800),Z1(800),K1
08100		COMMON /B/X2(800),Y2(800),Z2(800),K2
08200		COMMON /C/X3(800),Y3(800),Z3(800),K3
08300		COMMON /D/X4(800),Y4(800),Z4(800),K4
08400	10	FORMAT(' TYPE PERCENT OF TRANSFORMATION (.5=50%)  '$)
08500	11	FORMAT(F)
08600		TYPE 10
08700		ACCEPT 11,P
08800		DO 1 K=1,K3
08900		A=X4(K)-X3(K)
09000		A=A*P+.5
09100		B=Y4(K)-Y3(K)
09200		B=B*P+.5
09300		X3(K)=X3(K)+A
09400	1	Y3(K)=Y3(K)+B
09500		END